mock_exercise <- function(
  user_code = "1 + 1",
  label = "ex",
  chunks = list(),
  engine = "r",
  global_setup = NULL,
  setup_label = NULL,
  solution_code = NULL,
  code_check = NULL,  # code_check chunk
  error_check = NULL, # error_check chunk
  check = NULL,       # check chunk
  tests = NULL,       # tests chunk
  exercise.checker = dput_to_string(debug_exercise_checker),
  exercise.error.check.code = dput_to_string(debug_exercise_checker),
  exercise.df_print = "default",
  exercise.warn_invisible = TRUE,
  exercise.timelimit = 10,
  fig.height = 4,
  fig.width = 6.5,
  fig.retina = 2,
  version = current_exercise_version,
  ...
) {
  default_options <- list(
    eval = FALSE,
    echo = TRUE,
    results = "markup",
    tidy = FALSE,
    collapse = FALSE,
    prompt = FALSE,
    comment = NA,
    highlight = FALSE,
    fig.width = fig.width,
    fig.height = fig.height,
    fig.retina = fig.retina,
    engine = engine,
    max.print = 1000,
    exercise.checker = exercise.checker,
    label = label,
    exercise = TRUE,
    exercise.setup = setup_label,
    code = user_code,
    fig.num = 0,
    exercise.df_print = exercise.df_print,
    exercise.warn_invisible = exercise.warn_invisible,
    exercise.timelimit = exercise.timelimit,
    exercise.error.check.code = exercise.error.check.code
  )

  has_exercise_chunk <- any(
    vapply(chunks, `[[`, logical(1), c("opts", "exercise"))
  )

  if (!has_exercise_chunk) {
    # create non-existent exercise chunk from global options
    chunks <- c(chunks, list(
      mock_chunk(
        label,
        user_code,
        exercise = TRUE,
        engine = engine,
        exercise.setup = setup_label
      )
    ))
  } else {
    # move opts from exercise chunk to global options
    idx_exercise_chunk <- which(has_exercise_chunk)

    if (length(idx_exercise_chunk) > 1) {
      rlang::abort("Exercises may have only one exercise chunk")
    }

    ex_chunk <- chunks[[idx_exercise_chunk]]

    # overwrite "global" options that would be pulled from exercise chunk
    default_options <- utils::modifyList(default_options, ex_chunk[["opts"]])

    warn_overwrite <- function(item, old) {
      if (item == "code") {
        rlang::warn("Overwriting mock exercise `user_code` using exercise chunk code")
      }
      msg <- sprintf("Overwriting mock exercise `%s` from '%s' to '%s'", item, old, ex_chunk[[item]])
      rlang::warn(msg)
    }

    if (!missing(label) && !identical(label, ex_chunk[["label"]])) {
      warn_overwrite("label", label)
    }
    if (!missing(engine) && !identical(engine, ex_chunk[["engine"]])) {
      warn_overwrite("engine", label)
    }
    if (!missing(user_code) && !identical(user_code, ex_chunk[["code"]])) {
      warn_overwrite("code", user_code)
    }

    label <- ex_chunk[["label"]]
    engine <- ex_chunk[["engine"]]
    user_code <- paste(ex_chunk[["code"]], collapse = "\n")
  }

  ex <- list(
    label = label,
    code = user_code,
    restore = FALSE,
    timestamp = as.numeric(Sys.time()),
    global_setup = paste(global_setup, collapse = "\n"), # added by get_global_setup()
    setup = mock_prep_setup(chunks, setup_label),        # walk setup chain
    chunks = chunks,
    solution = solution_code,
    code_check = code_check,
    error_check = error_check,
    check = check,
    tests = split_code_headers(tests, "test"),
    options = utils::modifyList(default_options, list(...)),
    engine = engine,
    version = version
  )

  stopifnot(is.null(version) || length(version) == 1)
  if (!is.null(version) && version %in% c("2", "3")) {
    ex$tutorial <- list(
      id = "mock_tutorial_id",
      version = "9.9.9",
      user_id = "the_learnr",
      learnr_version = as.character(utils::packageVersion("learnr"))
    )
    if (version == "3") {
      ex$tutorial$language <- "en"
    }
  }

  structure(ex, class = c("mock_exercise", "tutorial_exercise"))
}

mock_prep_setup <- function(chunks, setup_label) {
  if (is.null(setup_label) || identical(trimws(setup_label), "")) {
    return("")
  }
  chunk_labels <- vapply(chunks, `[[`, character(1), "label")
  if (!identical(unique(chunk_labels), chunk_labels)) {
    stop("Duplicated chunk labels: ", chunk_labels[duplicated(chunk_labels)])
  }
  setup <- c()
  visited_setup_chunks <- c()
  while (!is.null(setup_label)) {
    if (setup_label %in% visited_setup_chunks) {
      stop(
        "Cycles detected in setup chunks: ",
        paste(visited_setup_chunks, collapse = " -> "),
        " -> ", setup_label
      )
    }
    found_chunk <- FALSE
    for (chunk in chunks) {
      if (identical(chunk$label, setup_label)) {
        setup <- c(chunk$code, setup)
        visited_setup_chunks <- c(visited_setup_chunks, setup_label)
        setup_label <- chunk$opts[["exercise.setup"]]
        found_chunk <- TRUE
        break
      }
    }
    if (!found_chunk) {
      stop(setup_label, " is not in `chunks`.")
    }
  }
  paste(setup, collapse = "\n")
}

mock_chunk <- function(label, code, exercise = FALSE, engine = "r", ...) {
  opts <- list(...)
  opts$label <- label
  opts$exercise <- exercise

  if (is.null(opts[["exercise.setup"]])) {
    opts[["exercise.setup"]] <- NULL
  }

  list(
    label = label,
    code = paste(code, collapse = "\n"),
    opts = opts,
    engine = engine
  )
}

#' @export
format.mock_exercise <- function(x, ...) {
  # in real exercises, the chunk options are stored as un-evaluated strings
  x$chunks <- lapply(x$chunks, function(chunk) {
    if (!isTRUE(chunk$opts$exercise)) {
      chunk$opts$exercise <- NULL
    }
    chunk$opts <- vapply(chunk$opts, dput_to_string, character(1))
    chunk
  })
  class(x) <- "tutorial_exercise"
  format(x, ...)
}
